Load libraries, the main ones being used are ggplot2 for
plotting, leaflet and tmap for interactive
maps, sf for spatial data processing,
tidyverse for data processing, and DT for
interactive tables.
Create a function to assign default behaviour for our DT
datatables.
# Function for default datatable params
datatable <- function(...) {
# Build arg list
args <- list(...)
# Default custom filename
filename <- if (!"filename" %in% names(args)) "data" else args$filename
args[["filename"]] <- NULL
# Add default extensions
args$extensions <- if (!"extensions" %in% names(args)) "Buttons" else args$extensions
# Add default args
args$filter <- if (!"filter" %in% names(args)) "top" else args$filter
args$fillContainer <- if (!"fillContainer" %in% names(args)) T else args$fillContainer
# Add default options
if (!"options" %in% names(args)) {
args$options <- list(
scrollY = "350px",
buttons = list(
list(
extend = "csv",
filename = filename,
exportOptions = list(columns = ":not(.rownames)")
),
list(
extend = "excel",
filename = filename,
exportOptions = list(columns = ":not(.rownames)"),
title = ""
)
),
columnDefs = list(
list(
targets = 0,
className = "rownames"
)
),
dom = "Bfrtip"
)
}
return(do.call(DT::datatable, args))
}Load the following data for the City of Toronto:
All collisions data was provided by David McElroy David.McElroy@toronto.ca from the City of Toronto on November 7, 2024.
Verified bikeways data originally from Konrad Samsel konrad.samsel@mail.utoronto.ca and later modified by Richard Wen richard.wen@utoronto.ca on October 27, 2024.
# Load boundaries
bounds_raw <- read_sf("../../data/toronto-boundary-2019-07-23/citygcs_regional_mun_wgs84.shp")
# Load toronto centrelines data
ctl_raw <- read_sf("../../data/toronto-centrelines-2024-12-06.geojson")
# Load toronto bikeways data
bike_raw <- read_sf("../../data/toronto-bikeways-2024-10-27.geojson")
# Load all toronto collisions from 2022 to 2024
colli_raw <- read_sf(
"../../tmp/i0327_collisionsrep_acc_export.csv",
options = c(
"X_POSSIBLE_NAMES=LONGITUDE",
"Y_POSSIBLE_NAMES=LATITUDE"
),
crs = 4326
)For the collisions:
ACCDATE to date
typeFor the verified bikeways:
For the centrelines, extract target streets Bloor Street, Danforth Street/Avenue, University Avenue, and Yonge Street, and merge all segments for each target street.
# Reproj city bounds to 4326
bounds <- bounds_raw %>% st_transform(4326)
# Crop colli to toronto bounds and convert date type
colli <- colli_raw %>%
st_intersection(bounds) %>%
mutate(colli_date = as_date(ACCDATE))
# Add a columns for ksi and road users
ksi_codes <- c("3", "4")
colli <- colli %>%
mutate(
ksi = if_else(INJURY %in% ksi_codes, "ksi", "non_ksi"), # ksi col
user = case_when( # road user col
INVTYPE %in% c("01", "02") ~ "driver",
INVTYPE == "03" ~ "pedestrian",
INVTYPE %in% c("04", "05") ~ "cyclist",
.default = "other"
)
)
# Get cycle tracks only after all upgrades
bike <- bike_raw %>%
mutate( # create col for target streets
target_street = case_when(
str_starts(street, "Bloor") ~
"Bloor Street",
str_starts(street, "University") ~
"University Avenue",
str_starts(street, "Yonge") ~
"Yonge Street",
str_starts(street, "Danforth") ~
"Danforth Street/Avenue",
.default = NA
)
) %>%
filter(!is.na(target_street)) %>%
mutate(
final_type = case_when( # col for final type without improvements
!is.na(verify_upgrade2_year) &
verify_upgrade2_type != verify_upgrade1_type
~ verify_upgrade2_type,
!is.na(verify_upgrade1_year) &
verify_upgrade1_type != verify_install_type
~ verify_upgrade1_type,
!is.na(verify_install_year)
~ verify_install_type,
.default = NA
),
final_type = case_when( # remap infra types to actual names
final_type %in% c("PL", "BUF") ~ "Painted Lane",
final_type == "PBL" ~ "Cycle Track",
.default = NA
)
) %>%
mutate( # col for final year without improvements
final_year = case_when(
!is.na(verify_upgrade2_year) &
verify_upgrade2_type != verify_upgrade1_type
~ verify_upgrade2_year,
!is.na(verify_upgrade1_year) &
verify_upgrade1_type != verify_install_type
~ verify_upgrade1_year,
!is.na(verify_install_year)
~ verify_install_year,
.default = NA
),
history = glue("
{verify_install_type},{verify_install_year} ->
{verify_upgrade1_type},{verify_upgrade1_year} ->
{verify_upgrade2_type},{verify_upgrade2_year}
")
) %>%
filter( # filter for cycle tracks only
final_type == "Cycle Track"
)
# Remove non pl and ct types
bike <- bike %>%
mutate(
verify_install_type = if_else(
verify_install_type %in% c("PL", "BUF", "PBL"),
verify_install_type,
NA
),
verify_upgrade1_type = if_else(
verify_upgrade1_type %in% c("PL", "BUF", "PBL"),
verify_upgrade1_type,
NA
),
verify_upgrade2_type = if_else(
verify_upgrade2_type %in% c("PL", "BUF", "PBL"),
verify_upgrade2_type,
NA
)
)
# Add history to bike lanes without improvements
bike <- bike %>%
mutate( # remove improvements
verify_upgrade1_year = if_else(
!is.na(verify_upgrade1_type) &
!is.na(verify_install_type) &
verify_install_type == verify_upgrade1_type,
NA,
verify_upgrade1_year
),
verify_upgrade1_type = if_else(
!is.na(verify_upgrade1_type) &
!is.na(verify_install_type) &
verify_install_type == verify_upgrade1_type,
NA,
verify_upgrade1_type
),
verify_upgrade2_year = if_else(
!is.na(verify_upgrade2_type) &
!is.na(verify_upgrade1_type) &
verify_upgrade2_type == verify_upgrade1_type,
NA,
verify_upgrade2_year
),
verify_upgrade2_type = if_else(
!is.na(verify_upgrade2_type) &
!is.na(verify_upgrade1_type) &
verify_upgrade2_type == verify_upgrade1_type,
NA,
verify_upgrade2_type
)
) %>%
mutate(
history = glue(
"{verify_install_type},{verify_install_year}",
" -> {verify_upgrade1_type},{verify_upgrade1_year}",
" -> {verify_upgrade2_type},{verify_upgrade2_year}",
) %>%
str_remove_all(" -> NA,NA|NA,NA -> |NA,NA")
)
# Filter centrelines for Bloor, University and Yonge
streets <- ctl_raw %>%
filter( # filter for streets only
FEATURE_CODE_DESC %in% c(
"Major Arterial",
"Major Arterial Ramp",
"Minor Arterial",
"Minor Arterial Ramp",
"Collector",
"Access Road",
"Other",
"Laneway",
"Local"
)
) %>%
mutate( # create col for streets bloor, uni, and yonge
target_street = case_when(
str_starts(
LINEAR_NAME_FULL_LEGAL,
"Bloor Street"
) ~ "Bloor Street",
str_starts(
LINEAR_NAME_FULL_LEGAL,
"University Avenue"
) ~ "University Avenue",
str_starts(
LINEAR_NAME_FULL_LEGAL,
"Yonge Street"
) ~ "Yonge Street",
str_starts( # Prince Edward Viaduct
LINEAR_NAME_FULL_LEGAL,
"Danforth Avenue|Danforth Street"
) ~ "Danforth Street/Avenue",
.default = NA
)
) %>%
filter(!is.na(target_street)) %>%
group_by(target_street) %>% # merge geoms on streets
summarize(geometry = st_union(geometry))Find all collision points within 25 meters of the verified bikeways on Yonge, Bloor and University.
# Get row indices of nearest bikeway to each collision
near_idx <- colli %>% st_nearest_feature(bike)
# Calc distances to nearest bikeway for each collision
colli_bike <- colli %>%
mutate( # calc dist to nearest bikeway for each ksi
`near_bike_meters` = st_distance(
geometry,
bike[near_idx, ],
by_element = T
) %>% as.numeric
)
# Get df version of bike and calc lens
bike_df <- bike %>%
mutate(
bike_len_km = as.numeric(st_length(geometry)) / 1000
) %>%
as_tibble %>%
select(-geometry)
# Add bike columns to collisions
colli_bike <- colli_bike %>%
mutate( # add ids for bike
bike_id = bike_df[near_idx, ]$id
) %>%
left_join( # add bike cols to colli
bike_df,
by = join_by(bike_id == id)
)
# Filter for collisions within 25 meters of the bikeways
colli_bike <- colli_bike %>%
filter(near_bike_meters <= 25)Count the injuries by the collision quarter, KSI/Non-KSI, and road user.
# Expand into bike events
colli_bike_proc <- colli_bike %>%
pivot_longer(
c(
verify_install_type,
verify_upgrade1_type,
verify_upgrade2_type
),
names_to = "event",
values_to = "type"
) %>%
mutate( # add time units
year = year(colli_date),
quarter = quarter(colli_date),
) %>%
mutate( # correct years and types
event_year = case_when(
str_starts(event, "verify_install_type") ~ verify_install_year,
str_starts(event, "verify_upgrade1_type") ~ verify_upgrade1_year,
str_starts(event, "verify_upgrade2_type") ~ verify_upgrade2_year
),
type = if_else(
is.na(type) & event == "verify_install_type",
"none",
type
),
type = case_when(
type %in% c("PL", "BUF") ~ "painted lane",
type == "PBL" ~ "cycle track",
.default = type
)
) %>%
filter( # remove na types
!is.na(type) &
year >= event_year
)
# Count by quarterly individuals
colli_counts <- colli_bike_proc %>%
as_tibble %>%
select(-geometry) %>%
rename(
orig_street = street,
street = target_street
) %>%
group_by(year, quarter, street, type, user, ksi) %>%
group_map(~ {
head(.x, 1) %>%
mutate(
n = nrow(.x),
n_segments = length(unique(.x$bike_id)),
n_len_km = .x %>% # calc lens of unique bikeways
distinct(bike_id, .keep_all = T) %>%
pull(bike_len_km) %>%
sum(na.rm = T)
) %>%
select(colnames(.y), n, n_segments, n_len_km)
}, .keep = T) %>%
bind_rows %>%
arrange(street, year, quarter, type, user, ksi) %>%
ungroup
# Add counts for Bloor and Danforth together
colli_counts <- colli_counts %>%
add_row(
colli_counts %>%
filter(street %in% c(
"Bloor Street",
"Danforth Street/Avenue")
) %>%
mutate(street = "Bloor & Danforth") %>%
group_by(year, quarter, street, type, user, ksi) %>%
summarize(
n = sum(n, na.rm = T),
n_segments = sum(n_segments, na.rm = T),
n_len_km = sum(n_len_km, na.rm = T)
)
)
# Create all combos of colli
colli_counts <- expand.grid(
year = min(colli_counts$year):max(colli_counts$year),
quarter = 1:4,
street = unique(colli_counts$street),
type = unique(colli_counts$type),
user = unique(colli_counts$user),
ksi = unique(colli_counts$ksi)
) %>%
left_join(
colli_counts,
by = c(
"year",
"quarter",
"street",
"type",
"user",
"ksi"
)
) %>%
mutate(
n = replace_na(n, 0),
n_segments = replace_na(n_segments, 0),
n_len_km = replace_na(n_len_km, 0)
) %>%
arrange(street, year, quarter, type, user, ksi)Add installs/upgrades of painted lane and cycle track infrastructure, if they are present in the collision quarter.
# Add bikeways for bloor and danforth together
bike_proc <- bike %>%
add_row(
bike %>%
filter(target_street %in% c(
"Bloor Street",
"Danforth Street/Avenue"
)) %>%
mutate(target_street = "Bloor & Danforth")
)
# Calc cycle track events with segment length and counts
bike_events <- data.frame(
year = c(
bike_proc$verify_install_year,
bike_proc$verify_upgrade1_year,
bike_proc$verify_upgrade2_year
),
add_type = c(
bike_proc$verify_install_type,
bike_proc$verify_upgrade1_type,
bike_proc$verify_upgrade2_type
),
street = rep(bike_proc$target_street, 3),
geometry = rep(bike_proc$geometry, 3)
) %>%
mutate(
add_type = case_when(
add_type %in% c("PL", "BUF") ~ "painted lane",
add_type == "PBL" ~ "cycle track",
.default = add_type
)
) %>%
filter(!is.na(year) & !is.na(add_type)) %>%
st_as_sf %>%
group_by(street, year, add_type) %>%
summarize(
add_len_km = as.numeric(sum(st_length(geometry))) / 1000,
add_segments = n()
) %>%
as_tibble %>%
select(-geometry) %>%
mutate(
add_year = year
) %>%
arrange(street, year) %>%
group_by(street) %>%
mutate(
add_segments = cumsum(add_segments)
) %>%
ungroup
# Fill years in between infra events
bike_events_fill <- bike_events %>%
group_by(street) %>%
group_map(~{
expand.grid(
year = min(colli_counts$year, na.rm = T):max(colli_counts$year, na.rm = T)
) %>%
left_join(.x, by = "year") %>%
fill(everything()) %>%
fill(street, .direction = "up")
}, .keep = T) %>%
bind_rows
# Add bike events to the counts
colli_counts <- colli_counts %>%
left_join(
bike_events_fill %>%
select(
year,
street,
add_segments,
add_type,
add_year,
add_len_km
),
by = c("year", "street")
) %>%
arrange(street, year, quarter, add_type, user, ksi)
# Add post col to define if year is post first install of a cycle track
colli_counts <- colli_counts %>%
group_by(street) %>%
group_map(~{
# Set out df
out <- .x
# Calculate first ct and pl if exists
pl_ymin <- colli_counts %>%
filter(add_type == "painted lane") %>%
pull(year)
ct_ymin <- colli_counts %>%
filter(add_type == "cycle track") %>%
pull(year)
# Post pl col
if (length(pl_ymin) > 0) {
out <- out %>%
mutate(
post_1st_pl = if_else(
.x$add_type == "painted lane" &
.x$year >= min(pl_ymin, na.rm = T),
T,
F
)
)
}
# Post first ct col
if (length(ct_ymin) > 0) {
out <- out %>%
mutate(
post_1st_ct = if_else(
.x$add_type == "cycle track" &
.x$year >= min(ct_ymin, na.rm = T),
T,
F
)
)
}
# Return df with post cols
return(out)
}, .keep = T) %>%
bind_rowsThe results contain:
The resulting data consists of the following columns:
year the year of the collisionsquarter: the quarter of the collisionsstreet: the street, one of Yonge Street, University
Avenue, or Bloor Streettype: the type of infrastructuresegments: the number of segmentslen_km: the total length of the segments in kmadd_year: the year that the infrastructure was
addedadd_type: the type of infrastructure addedadd_segments: the number of segments of the
infrastructure addedadd_len_km: the length of the infrastructure addedpost_1st_ct: whether the year is on or after the first
cycle track implementationpost_1st_pl: whether the year is on or after the first
painted or buffered lane implementationksi: the total number of Killed or Seriously Injured
(KSI) collisionsnon_ksi: the total number of non-KSI collisions<USER>_ksi: the number of KSI individuals for a
road user group indicated by <USER><USER>_non_ksi: the number of non-KSI individuals
for a road user group indicated by <USER><USER>_ksi_mean: the average number of KSI
individuals for a road user group indicated by <USER>
per segment<USER>_non_ksi_mean: the average number of
non-KSI individuals for a road user group indicated by
<USER> per segment# Create output data
out <- colli_counts %>%
mutate(
group = glue("{user}_{ksi}")
) %>%
pivot_wider(
values_from = n,
names_from = group
) %>%
select(-user, -ksi) %>%
group_by(year, quarter, street, type) %>%
summarize(
across(
ends_with("_ksi"),
~ sum(., na.rm = T)
),
across(
c("add_year", "add_type"),
~ paste0(unique(.), collapse = ",")
),
across(
starts_with("post_"),
~ any(.)
),
n_segments = sum(as.numeric(unique(n_segments)), na.rm = T),
n_len_km = sum(as.numeric(unique(n_len_km)), na.rm = T),
add_type = unique(add_type),
add_segments = sum(as.numeric(unique(add_segments)), na.rm = T),
add_len_km = sum(as.numeric(unique(add_len_km)), na.rm = T)
) %>%
ungroup %>%
mutate( # calc total ksi
ksi = select(., !ends_with ("_non_ksi") & ends_with("_ksi")) %>%
rowSums(na.rm = T),
non_ksi = select(., ends_with("_non_ksi")) %>%
rowSums(na.rm = T),
across(starts_with("post_"), ~ if_else(is.na(.), F, .)),
across(ends_with("_ksi"), ~ . / n_segments, .names = "{.col}_mean")
) %>%
mutate(across( # set nan to na
everything(),
~ ifelse(is.nan(.), NA, .)
)) %>%
select(order(colnames(.))) %>%
select(
year,
quarter,
street,
type,
segments = n_segments,
len_km = n_len_km,
add_year,
add_type,
add_segments,
add_len_km,
starts_with("post_"),
ksi,
non_ksi,
everything()
) %>%
arrange(street, year, quarter, type)
# Show data table
datatable(
out,
filename = glue("toronto-collisions-bloorunidanyonge-{today()}")
)The rates data consists of quarterly rates by road user per year.
year the year of the collisionsstreet: the street, one of Yonge Street, University
Avenue, or Bloor Streettype: the type of infrastructuresegments: the number of segmentslen_km: the total length of the segments in kmadd_year: the year that the infrastructure was
addedadd_type: the type of infrastructure addedadd_segments: the number of segments of the
infrastructure addedadd_len_km: the length of the infrastructure addedpost_1st_ct: whether the year is on or after the first
cycle track implementationpost_1st_pl: whether the year is on or after the first
painted or buffered laneksi: the total number of Killed or Seriously Injured
(KSI) collisionsnon_ksi: the total number of non-KSI collisions<USER>_ksi: the number of KSI individuals for a
road user group indicated by <USER><USER>_non_ksi: the number of non-KSI individuals
for a road user group indicated by <USER><USER>_ksi_mean: the average number of KSI
individuals for a road user group indicated by <USER>
per segment<USER>_non_ksi_mean: the average number of
non-KSI individuals for a road user group indicated by
<USER> per segment<USER>_ksi_mean_quarter: the average number of
KSI individuals for a road user group indicated by
<USER> per quarter<USER>_non_ksi_mean_quarter: the average number
of non-KSI collisions for a road user group indicated by
<USER> per quarter# Calc rates for output
out_rates <- out %>%
group_by(street, year, type) %>%
summarize(
across( # means
ends_with("ksi"),
~ sum(., na.rm = T) / sum(segments, na.rm = T),
.names = "{.col}_mean"
),
across( # quarterly means
ends_with("ksi_mean"),
~ . / 4,
.names = "{.col}_quarter"
),
across( # sums
ends_with("ksi"),
~ sum(., na.rm = T)
),
across( # sum other vars
c(segments, len_km),
~ sum(., na.rm = T)
),
across( # unique other vars
starts_with("add_") | starts_with("post_"),
~ paste0(unique(.), collapse = ",")
)
) %>%
mutate(across( # set nan to na
everything(),
~ ifelse(is.nan(.), NA, .)
)) %>%
select(order(colnames(.))) %>%
select(
year,
street,
type,
segments,
len_km,
add_year,
add_type,
add_segments,
add_len_km,
starts_with("post_"),
ksi,
non_ksi,
ends_with("_ksi"),
ksi_mean,
non_ksi_mean,
ends_with("_mean"),
ksi_mean_quarter,
non_ksi_mean_quarter,
ends_with("_mean_quarter"),
everything()
) %>%
arrange(street, year, type)
# Show data table
datatable(
out_rates,
filename = glue("toronto-collisions-bloorunidanyonge-rates-{today()}")
)These plots show the number of KSI collisions by road user for cycle tracks on Bloor Street, Danforth Street/Avenue, University Avenue, and Yonge Street. The dark gray dotted vertical lines show which year a cycle track is added to the street along with the amount of cycle track kilometers added.
# Prep plot data
plot_data <- colli_bike %>%
as_tibble %>%
select(-geometry) %>%
mutate(
year = year(colli_date),
quarter = quarter(colli_date),
user = str_to_title(user),
ksi = if_else(ksi == "non_ksi", "Non-KSI", "KSI")
) %>%
filter(user != "Other") %>%
rename(
street_orig = street,
street = target_street
) %>%
group_by(street, year, quarter, user, ksi) %>%
count
# Add bike events to plot data
plot_data <- plot_data %>%
left_join(
bike_events_fill,
by = c("street", "year")
)
# Add cumulative sums for ct len
plot_data <- plot_data %>%
group_by(street, user, ksi) %>%
mutate(
csum_km_ct = if_else(
add_type == "cycle track" & year == add_year & quarter == 1,
add_len_km,
0
) %>% replace_na(0),
csum_km_ct = cumsum(csum_km_ct)
) %>%
arrange(street, year, quarter, user, ksi) %>%
mutate(
quarter_date = as_date(glue("{year}-0{quarter * 3}-01"))
)# Generate plot for non ksi
ggplot(
plot_data %>%
filter(ksi == "Non-KSI" & !is.na(n)),
aes(x = quarter_date, y = n)
) +
geom_line(
aes(color = csum_km_ct)
) +
facet_grid(
user ~ street,
scales = "free",
switch = "y"
) +
geom_text(
aes(label = n),
size = 2.25,
angle = 90,
hjust = -2
) +
scale_color_gradient(
low = "lightgray",
high = "black",
name = "Cycle Track (km)",
breaks = c(0, 2, 4, 6, 8, 10, 12, 15)
) +
theme_minimal() +
scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
scale_y_continuous(expand = expansion(mult = c(0.1, 0.3))) +
labs(
x = "Year",
y = "Non-KSI Individuals"
) +
theme(
axis.text.x = element_text(size = 8),
legend.position = "top"
)
# Generate plot for non ksi
ggplot(
plot_data %>%
filter(ksi == "KSI" & !is.na(n)),
aes(x = quarter_date, y = n)
) +
geom_line(
aes(color = csum_km_ct)
) +
facet_grid(
user ~ street,
scales = "free",
switch = "y"
) +
geom_text(
aes(label = n),
size = 2.25,
angle = 90,
hjust = -2
) +
scale_color_gradient(
low = "lightgray",
high = "black",
name = "Cycle Track (km)",
breaks = c(0, 2, 4, 6, 8, 10, 12, 15)
) +
theme_minimal() +
scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
scale_y_continuous(expand = expansion(mult = c(0.1, 0.3))) +
labs(
x = "Year",
y = "KSI Individuals"
) +
theme(
axis.text.x = element_text(size = 8),
legend.position = "top"
)
These map show the location of cycle tracks on Bloor Street, Danforth Street/Avenue, University Avenue, and Yonge Street, along with the collision density (determined by the number of individuals involved) within 25 meters of each cycle track.
Pre means before the noted year, and post means on or after the noted year (e.g. Pre-2022 is before 2022 and Post-2022 is on or after 2022).
# Function to produce a heatmap
plot_map <- function(
user_type = NULL,
ksi_type = NULL,
pre = NULL,
post = NULL,
radius = 8,
heatmap = T
) {
# Filter colli data
plot_colli <- colli_bike %>%
mutate(
year = year(colli_date)
)
if (!is.null(user_type)) {
plot_colli <- plot_colli %>% filter(user %in% user_type)
}
if (!is.null(ksi_type)) {
plot_colli <- plot_colli %>% filter(ksi %in% ksi_type)
}
if(!is.null(pre)) {
plot_colli <- plot_colli %>% filter(year < pre)
}
if(!is.null(post)) {
plot_colli <- plot_colli %>% filter(year >= post)
}
# Plot map
tmap_mode("view")
p <- tm_shape(bounds) +
tm_polygons(alpha = 0, popup.vars = F, id = "") +
tm_shape(streets) +
tm_lines(col = "#1d1d1d", popup.vars = T) +
tm_text("target_street", size = 1) +
tm_shape(
bike %>%
select(-ends_with("_comment")) %>%
filter(target_street != "Bloor & Danforth")
) +
tm_lines(col = "red", lwd = 2, popup.vars = T)
# If no heatmap, use points
if (!heatmap) {
p <- p +
tm_shape(plot_colli) +
tm_dots(clustering = T)
}
# Convert to leaflet
p <- tmap_leaflet(p)
# Add controls and legends
p <- p %>%
addFullscreenControl %>%
addLegend(
position = "topright",
colors = c("red", "#1d1d1d"),
labels = c("Cycle Track", "Street")
) %>%
addLegend(
position = "topright",
colors = colorNumeric(
c("blue", "green", "yellow", "orange"),
domain = NULL
)(seq(1, 100, length.out = 5)),
values = c(1, 10),
labels = c("Low", "", "", "", "High"),
title = "Collision<br/>Density"
)
# Add heatmap
if (heatmap) {
p <- p %>% addHeatmap(
data = plot_colli,
lat = ~LATITUDE,
lng = ~LONGITUDE,
radius = radius
)
} else {
p <- p %>%
htmlwidgets::onRender("
function(el, x) {
var css = '.marker-cluster span { color: black; font-size: 12px; }';
var style = document.createElement('style');
style.type = 'text/css';
if (style.styleSheet) {
style.styleSheet.cssText = css;
} else {
style.appendChild(document.createTextNode(css));
}
document.head.appendChild(style);
}
")
}
return(p)
}No Data.